home *** CD-ROM | disk | FTP | other *** search
Oberon Text | 1995-06-30 | 12.4 KB | 286 lines | [TEXT/.Ob4] |
- Syntax10.Scn.Fnt
- Syntax10i.Scn.Fnt
- StampElems
- Alloc
- 30 Jan 95
- Syntax10b.Scn.Fnt
- MODULE DialogTexts;
- (** Markus Knasm
- ller 8 Jun 94 -
- IMPORT DialogFrames, Dialogs, Display, Files, GraphicUtils, In, MenuViewers, Oberon, Texts, TextFrames, Types, Viewers;
- CONST
- W* = 70; H* = 22; white = 0; black = 15; grey1 = 11; minH = 16;
- editMenu = "System.Close System.Copy System.Grow ";
- TYPE
- Item* = POINTER TO ItemDesc;
- ItemDesc* = RECORD(Dialogs.ObjectDesc)
- f: TextFrames.Frame;
- END;
- ChangeMsg = RECORD (Display.FrameMsg);
- x, y: LONGINT;
- END;
- VAR
- w0: Texts.Writer;
- GetParText*: PROCEDURE (n: ARRAY OF CHAR; p: Dialogs.Panel; VAR t: Texts.Text);
- (** returns the generated parameter t, defined by the text items of panel p, which names are contained in n *)
- PROCEDURE (t: Item) Copy* (VAR dup: Dialogs.Object);
- (** allocates dup and makes a deep copy of o. Before calling this methode dup should be equal NIL *)
- VAR x: Item; t0: Texts.Text;
- BEGIN
- IF dup = NIL THEN NEW (x); dup := x ELSE x := dup(Item) END;
- t.Copy^ (dup);
- NEW (t0); t0 := TextFrames.Text (""); x.f := TextFrames.NewText (t0, 0)
- END Copy;
- PROCEDURE (t: Item) GetText* (): Texts.Text;
- (** returns the text of the item *)
- BEGIN RETURN t.f.text
- END GetText;
- PROCEDURE (t: Item) SetSelection* (beg, end: LONGINT);
- (** sets the selection to the interval [beg..end[ *)
- BEGIN IF t.f # NIL THEN TextFrames.SetSelection (t.f, beg, end) END
- END SetSelection;
- PROCEDURE (t: Item) RemoveSelection*;
- (** removes the selection *)
- BEGIN IF t.f # NIL THEN TextFrames.RemoveSelection (t.f) END
- END RemoveSelection;
- PROCEDURE ParText (n: ARRAY OF CHAR; p: Dialogs.Panel; VAR t: Texts.Text);
- (* returns the generated parameter t, defined by the text items of panel p, which names are contained in n *)
- VAR t0, t1: Texts.Text; s: Texts.Scanner; o: Dialogs.Object;
- BEGIN
- t := TextFrames.Text (""); t0 := TextFrames.Text ("");
- Texts.WriteString (w0, n); Texts.Append (t0, w0.buf);
- Texts.OpenScanner (s, t0, 0); Texts.Scan (s);
- WHILE (s.class # Texts.Char) OR (s.c # 0X) DO
- IF s.class = Texts.Name THEN
- o := p.NamedObject (s.s);
- IF (o # NIL) & (o IS Item) THEN
- t1 := o(Item).GetText ();
- Texts.Save (t1, 0, t1.len, w0.buf); Texts.WriteString (w0, " ");
- Texts.Append (t, w0.buf)
- END
- ELSIF s.class = Texts.String THEN
- Texts.WriteString (w0, s.s); Texts.Append (t, w0.buf)
- END;
- Texts.Scan (s)
- END
- END ParText;
- PROCEDURE DrawFrame (f1, f: Display.Frame; m: BOOLEAN);
- VAR mode: INTEGER;
- BEGIN
- IF m THEN mode := Display.invert ELSE mode := Display.replace END;
- Display.ReplConstC (f1, black, f.X - 1, f.Y, 1, f.H + 1, mode); Display.ReplConstC (f1, white, f.X + f.W, f.Y, 1, f.H + 1, mode);
- Display.ReplConstC (f1, white, f.X, f.Y, f.W - 1, 1, mode); Display.ReplConstC (f1, black, f.X, f.Y + f.H, f.W - 1, 1, mode)
- END DrawFrame;
- PROCEDURE Adjust (f: TextFrames.Frame; id, dY, y, h: INTEGER);
- VAR m: MenuViewers.ModifyMsg;
- BEGIN
- m.id := id; m.dY := dY; m.Y := y; m.H := 0; f.handle (f, m);
- m.id := id; m.dY := dY; m.Y := y; m.H := h; f.handle (f, m);
- END Adjust;
- PROCEDURE (t: Item) Draw* (x, y: INTEGER; f: Display.Frame);
- (** displays the object at (x, y) in frame f *)
- VAR w, h, w1, h1, ox, oy: INTEGER;
- BEGIN
- INC (x); t.GetDim (ox, oy, w, h); DEC (w, 2); DEC (h);
- (* checks wether textframe is visible *)
- IF (y + h <= f.Y) OR (y >= f.Y + f.H) OR (x + w <= f.X) OR (x >= f.X + f.W) THEN RETURN END;
- (* corrects x and y such that the lower left coordinats of the textframes are visible *)
- IF (x < f.X) & (x + w > f.X) THEN w := w - (f.X - x); x := f.X END;
- IF (y < f.Y) & (y + h > f.Y) THEN h := h- (f.Y - y); y := f.Y END;
- (* corrects wide and height such that the full textframe can be displayed *)
- w1 := f.W - (x - f.X); h1 := f.H - (y - f.Y);
- IF w1 < t.f.left THEN RETURN END;
- IF w > w1 THEN w := w1 END; IF h > h1 THEN h := h1 END;
- IF w < 0 THEN w := 0 END; IF h < 0 THEN h := 0 END;
- t.f.X := x; t.f.Y := y; t.f.W := w; t.f.H := h;
- Oberon.RemoveMarks (f.X, f.Y, f.W, f.H); DrawFrame (f, t.f, t.selected);
- t.f.barW := 0; t.f.left := 3; t.f.right := 3; t.f.bot := 0; t.f.top := 2;
- Adjust (t.f, MenuViewers.extend, 0, t.f.Y + 1, t.f.H - 1);
- END Draw;
- PROCEDURE (t: Item) Print* (x, y: INTEGER);
- (** prints the object at printer coordinates (x, y) *)
- VAR ox, oy, ow, oh: INTEGER;
- BEGIN t.GetPDim (ox, oy, ow, oh); GraphicUtils.PrintBox (x, y, ow, oh)
- END Print;
- PROCEDURE (t: Item) Handle* (f: Display.Frame; VAR msg: Display.FrameMsg);
- (** handles messages which were sent to frame f *)
- VAR x, y, w, h, h1, xh, yh: INTEGER; v: Viewers.Viewer; msg1: Oberon.CopyMsg;
- f1: Display.Frame; cond: BOOLEAN; msg2: ChangeMsg; t1: Texts.Text;
- BEGIN
- t.Handle^ (f, msg); t.GetDim (x, y, w, h);
- (* checks textframe is visible ? *)
- WITH f: DialogFrames.Frame DO
- yh := f.Y + f.H + y; xh := f.X + x;
- IF yh < f.Y THEN h1 := h - f.Y + yh ELSE h1 := h END;
- IF (yh + h <= f.Y) OR (yh >= f.Y + f.H) OR (xh + w <= f.X) OR (xh >= f.X + f.W) OR (h1 < minH) THEN RETURN END;
- IF (f.X <= t.f.X) & (f.X + f.W >= t.f.X) & (f.Y <= t.f.Y) & (f.Y + f.H >= t.f.Y) THEN
- IF msg IS TextFrames.UpdateMsg THEN
- IF msg(TextFrames.UpdateMsg).text = t.f.text THEN
- t.f.handle (t.f, msg); msg2.x := f.X; msg2.y := f.Y; Viewers.Broadcast (msg2);
- IF (f.X > t.f.X) OR (f.X + f.W < t.f.X) OR (f.Y > t.f.Y) OR (f.Y + f.H < t.f.Y) THEN
- t.Draw (f.X + x, f.Y + f.H + y, f)
- END;
- IF t.cmd[0] # 0X THEN
- GetParText (t.par, t.panel, t1);
- t.CallCmd (f, Viewers.This (xh, yh), t1)
- END
- END
- ELSIF msg IS MenuViewers.ModifyMsg THEN
- IF msg(MenuViewers.ModifyMsg).id = MenuViewers.reduce THEN t.Restore END
- ELSE
- t.f.handle (t.f, msg);
- END;
- ELSE
- cond := FALSE;
- WITH msg: Oberon.InputMsg DO
- IF (msg.id = Oberon.track) &
- (msg.X >= xh) & (msg.X <= xh + w) & (msg.Y >= yh) & (msg.Y <= yh+ h) & (msg. keys # {}) THEN cond := TRUE;
- END;
- IF msg.id = Oberon.defocus THEN cond := TRUE END
- | msg: ChangeMsg DO
- t.Draw (f.X + x, f.Y + f.H + y, f)
- ELSE
- END;
- IF cond THEN
- TextFrames.RemoveCaret (t.f); t.Draw (f.X + x, f.Y + f.H + y, f); t.f.handle (t.f, msg)
- END
- END
- ELSE
- END;
- END Handle;
- PROCEDURE (t: Item) Init*;
- (** initialies the object, should be called after allocating the object with NEW *)
- VAR h: Texts.Text;
- BEGIN t.Init^; h := TextFrames.Text (""); t.f := TextFrames.NewText (h, 0);
- END Init;
- PROCEDURE Insert*;
- (** Insert ([name] [x y w h] | ^ ) inserts a text - item in the panel containing the caret position *)
- VAR x, y, x1, y1, w, h: INTEGER; t: Item; p: Dialogs.Panel; name: ARRAY 64 OF CHAR;
- BEGIN
- NEW (t);
- DialogFrames.GetCaretPosition (p, x, y);
- IF (p # NIL) THEN
- t.Init; In.Open; In.Name (name);
- IF ~In.Done THEN COPY ("", name); In.Open END;
- t.SetName (name);
- In.Int (x1); In.Int (y1); In.Int (w); In.Int (h);
- IF ~In.Done THEN x1 := x; y1 := y; w := W; h := H
- ELSE
- IF w < 0 THEN w := W END;
- IF h < 0 THEN h := H END
- END;
- t.SetDim (x1, y1, w, h, FALSE); p.Insert (t, FALSE)
- ELSE
- Dialogs.res := Dialogs.noPanelSelected
- END;
- IF Dialogs.res # 0 THEN Dialogs.Error ("DialogTexts") END;
- END Insert;
- PROCEDURE WriteToObjectInt (o: Dialogs.Object; VAR p: Dialogs.Panel; x: INTEGER);
- VAR t: Texts.Text;
- BEGIN
- WITH o: Item DO
- t := o.GetText (); Texts.WriteInt (w0, x, 1); Texts.Append (t, w0.buf);
- END
- END WriteToObjectInt;
- PROCEDURE WriteToObjectStr (o: Dialogs.Object; VAR p: Dialogs.Panel; n: ARRAY OF CHAR);
- VAR t: Texts.Text; ch: CHAR;
- BEGIN
- IF n[0] = 0X THEN RETURN END;
- WITH o: Item DO
- ch := CHR (34); (* " *)
- IF (ORD (CAP(n[0])) < ORD ("A")) OR (ORD (CAP(n[0])) > ORD ("Z")) THEN Texts.Write (w0, ch) END;
- t := o.GetText (); Texts.WriteString (w0, n);
- IF (ORD (CAP(n[0])) < ORD ("A")) OR (ORD (CAP(n[0])) > ORD ("Z")) THEN Texts.Write (w0, ch) END;
- Texts.Append (t, w0.buf);
- END
- END WriteToObjectStr;
- PROCEDURE Edit (o: Dialogs.Object);
- VAR
- x, y, nx, ny, nw, nh: INTEGER; nn, nc, np: ARRAY 64 OF CHAR;
- ox, oy, ow, oh, on, oc, op: Dialogs.Object; deInit: Dialogs.Panel;
- msg: DialogFrames.GetFrameMsg; file: Files.File; r: Files.Rider; type: Types.Type;
- m: TextFrames.Frame; v: Viewers.Viewer; df: DialogFrames.Frame; t: Texts.Text;
- BEGIN
- Oberon.AllocateSystemViewer (Oberon.Mouse.X, x, y);
- msg.p := Dialogs.editPanel; msg.f := NIL; Viewers.Broadcast (msg);
- IF msg.f = NIL THEN
- NEW (df); deInit := Dialogs.deInit.Copy ();
- df.Open (DialogFrames.Handle, deInit);
- Oberon.AllocateSystemViewer (Oberon.Mouse.X, x, y);
- type := Types.TypeOf (o);
- m := TextFrames.NewMenu (type.module.name, editMenu);
- v := MenuViewers.New (m, df, TextFrames.menuH, x, y);
- ELSE
- deInit := Dialogs.deInit.Copy (); msg.f.panel := deInit; deInit.Restore;
- END;
- ox := deInit.NamedObject ("x"); oy := deInit.NamedObject ("y");
- ow := deInit.NamedObject ("w"); oh := deInit.NamedObject ("h");
- on := deInit.NamedObject ("name"); oc := deInit.NamedObject ("cmd");
- op := deInit.NamedObject ("par");
- o.GetDim (nx, ny, nw, nh); COPY (o.name, nn); COPY (o.cmd, nc); COPY (o.par, np);
- WriteToObjectInt (ox, deInit, nx); WriteToObjectInt (oy, deInit, ny);
- WriteToObjectInt (ow, deInit, nw); WriteToObjectInt (oh, deInit, nh);
- WriteToObjectStr (on, deInit, nn); WriteToObjectStr (oc, deInit, nc);
- t := op(Item).GetText (); Texts.WriteString (w0, np); Texts.Append (t, w0.buf);
- Dialogs.editPanel := deInit; Dialogs.editObject := o;
- END Edit;
- PROCEDURE Update (o: Dialogs.Object; deInit: Dialogs.Panel);
- VAR
- o1: Dialogs.Object; st: ARRAY 64 OF CHAR;
- ax, ay, aw, ah, nx, ny, nw, nh, res, res1, res2, res3, res4: INTEGER;
- PROCEDURE ReadInt (o: Dialogs.Object; VAR x, res: INTEGER);
- VAR s: Texts.Scanner; t: Texts.Text;
- BEGIN
- WITH o: Item DO
- t := o.GetText (); Texts.OpenScanner (s, t, 0); Texts.Scan (s);
- IF (s.class = Texts.Int) THEN x := SHORT (s.i); res := Dialogs.ok ELSE res := Dialogs.wrongInput END
- ELSE
- END;
- END ReadInt;
- PROCEDURE ReadName (o: Dialogs.Object; VAR st: ARRAY OF CHAR ; VAR res: INTEGER);
- VAR s: Texts.Scanner; t: Texts.Text; i: INTEGER;
- BEGIN
- WITH o: Item DO
- t := o.GetText (); Texts.OpenScanner (s, t, 0); Texts.Scan (s);
- IF (s.class = Texts.Name) OR (s.class = Texts.String) THEN COPY (s.s, st); res := Dialogs.ok
- ELSE res := Dialogs.wrongInput END
- ELSE
- END;
- END ReadName;
- PROCEDURE ReadPar (o: Dialogs.Object; VAR st: ARRAY OF CHAR; VAR res: INTEGER);
- VAR r: Texts.Reader; t: Texts.Text; i: INTEGER; ch: CHAR;
- BEGIN
- WITH o: Item DO
- t := o.GetText (); Texts.OpenReader (r, t, 0); Texts.Read (r, ch); i := 0; res := Dialogs.ok;
- WHILE ~r.eot DO
- st[i] := ch; INC (i); Texts.Read (r, ch)
- END;
- st[i] := 0X
- ELSE
- END
- END ReadPar;
- BEGIN
- o1 := deInit.NamedObject ("name"); ReadName (o1, st, res1);
- IF res1 = Dialogs.ok THEN o.SetName (st); ELSE o.SetName ("") END;
- IF Dialogs.res # Dialogs.ok THEN Dialogs.Error ("Dialog") END;
- o1 := deInit.NamedObject ("cmd"); ReadName (o1, st, res1);
- IF res1 = Dialogs.ok THEN o.SetCmd (st) ELSE o.SetCmd ("") END;
- o1 := deInit.NamedObject ("par"); ReadPar (o1, st, res1);
- IF res1 = Dialogs.ok THEN o.SetPar (st) ELSE o.SetPar ("") END;
- o1 := deInit.NamedObject ("x"); ReadInt (o1, nx, res1);
- o1 := deInit.NamedObject ("y"); ReadInt (o1, ny, res2);
- o1 := deInit.NamedObject ("w"); ReadInt (o1, nw, res3);
- o1 := deInit.NamedObject ("h"); ReadInt (o1, nh, res4);
- IF (res1 # Dialogs.ok) OR (res2 # Dialogs.ok) OR (res3 # Dialogs.ok) OR (res4 # Dialogs.ok) THEN
- Dialogs.res := Dialogs.wrongInput; Dialogs.Error ("Dialog");
- ELSE
- o.GetDim (ax, ay, aw, ah);
- IF (ax # nx) OR (ay # ny) OR (aw # nw) OR (ah # nh) THEN
- o.SetDim (nx, ny, nw, nh, o.overlapping);
- IF Dialogs.res # Dialogs.ok THEN Dialogs.Error ("Dialog") END
- END
- END
- END Update;
- BEGIN Texts.OpenWriter (w0); Dialogs.Edit := Edit; Dialogs.Update := Update; GetParText := ParText
- END DialogTexts.
-